(COMMENT GENERALLY USEFUL LISP MACROS)

(DEFPROP DFUNC
 (LAMBDA (L)
  (LIST (Q DEFPROP) (CAADR L) (MCONS (Q LAMBDA) (CDADR L) (CDDR L)) (Q EXPR)))
 MACRO)

(DEFPROP MAPDEF
 (LAMBDA (L)
  (LIST	(Q MAPCAR)
	(SUBST (CADR L)
	       (Q IND)
	       (Q (FUNCTION (LAMBDA (PAIR)
			     (PUTPROP (CAR PAIR) (CADR PAIR) (QUOTE IND))))))
	(LIST (Q QUOTE) (CDDR L))))
 MACRO)

(DEFPROP MCONS
	 (LAMBDA (L)
		 (COND ((NULL (CDDR L)) (CADR L))
		       (T (LIST (Q CONS) (CADR L) (CONS (CAR L) (CDDR L))))))
	 MACRO)

(DEFPROP Q (LAMBDA (L) (CONS (QUOTE QUOTE) (CDR L))) MACRO)

(COMMENT END OF GENERAL LISP MACROS)


(COMMENT PROPERTY TABLE PRIMITIVES)

(DEFPROP FIRSTPROP (LAMBDA (L) (CONS (Q CDR) (CDR L))) MACRO)

(DEFPROP LASTPROP (LAMBDA (L) (CONS (Q NULL) (CDR L))) MACRO)

(DEFPROP NEXTPROP (LAMBDA (L) (CONS (Q CDDR) (CDR L))) MACRO)

(DEFPROP PROPNAM (LAMBDA (L) (CONS (Q CAR) (CDR L))) MACRO)

(DEFPROP PROPTABLE (LAMBDA (L) (CONS (Q CDR) (CDR L))) MACRO)

(DEFPROP PROPVAL (LAMBDA (L) (CONS (Q CADR) (CDR L))) MACRO)

(DFUNC (DELETEPROP IDENT PROPNAM)
 (PROG (TEM)
       (SETQ TEM IDENT)
  LOOP (COND ((NULL (CDR TEM)) (RETURN NIL)))
       (COND ((EQ (CADR TEM) PROPNAM) (RPLACD TEM (CDDDR TEM)) (RETURN T)))
       (SETQ TEM (CDDR TEM))
       (GO LOOP)))

(DFUNC (GETGET ATOM PROP)
       (PROG (TEM PTAB)
	     (SETQ PTAB (FIRSTPROP ATOM))
	LOOP (COND ((LASTPROP PTAB) (RETURN NIL)))
	     (COND ((SETQ TEM (SEEKPROP (PROPNAM PTAB) PROP)) (RETURN TEM)))
	     (SETQ PTAB (NEXTPROP PTAB))
	     (GO LOOP)))

(DFUNC (INITPROP IDENT PROPNAM PROPVAL)
       (RPLACD IDENT (MCONS PROPNAM PROPVAL (CDR IDENT))))

(DFUNC (SEEKPROP IDENT PROP) (GETL IDENT (LIST PROP)))

(DFUNC (SETPROP IDENT PROPNAM PROPVAL) (PUTPROP IDENT PROPVAL PROPNAM))

(COMMENT END OF PROPERTY TABLE PRIMITIVES)


(DECLARE (SPECIAL LINCNT PAGEHEIGHT PAGEWIDTH)
	 (SPECIAL *SP *TB *CR *LF *VT *FF *CO *PT)
	 (SPECIAL *LP *RP *SL *AM *RO *AT *LB *RB)
	 (DEFPROP DATAERR T *FSUBR))

(COMMENT FORMAT PROGRAM MACROS)

(DEFPROP ATLEFT (LAMBDA (L) (LIST (Q EQ) 1 (Q (CURCOL)))) MACRO)

(DEFPROP COLUMN (LAMBDA (L) (CONS (Q CAR) (CDR L))) MACRO)

(DEFPROP HEIGHT (LAMBDA (L) (CONS (Q CADR) (CDR L))) MACRO)

(DEFPROP NEWPLATE (LAMBDA (L) (LIST (Q LIST) 0 1 0)) MACRO)

(DEFPROP TEXT (LAMBDA (L) (CONS (Q CDDDR) (CDR L))) MACRO)

(DEFPROP WIDTH (LAMBDA (L) (CONS (Q CADDR) (CDR L))) MACRO)

(COMMENT END OF FORMAT PROGRAM MACROS)

(DFUNC (ALTERCOL PLATE NUM) (PROG2 (RPLACA PLATE NUM) PLATE))

(DFUNC (ALTERHT PLATE NUM) (PROG2 (RPLACA (CDR PLATE) NUM) PLATE))

(DFUNC (ALTERTEXT PLATE TEXT) (PROG2 (RPLACD (CDDR PLATE) TEXT) PLATE))

(DFUNC (ALTERWDTH PLATE NUM) (PROG2 (RPLACA (CDDR PLATE) NUM) PLATE))


(DFUNC (COMPOSASSIGN EXPR WIDTH RPARS SLACK)
       (PROG (PLATE MARG REST)
	     (SETQ PLATE (NEWPLATE))
	     (SETLPR PLATE)
	     (SETEXPR PLATE (CAR EXPR))
	     (SETSPC PLATE)
	     (SETEXPR PLATE (CADR EXPR))
	     (SETQ MARG (ADD1 (COLUMN PLATE)))
	     (SETQ REST	(COMPOSLIST (CDDR EXPR)
				    (*DIF WIDTH MARG)
				    (ADD1 RPARS)
				    (PLUS SLACK (SUB1 MARG))))
	     (COND ((NOT (*GREAT (FULLWTH REST (ADD1 RPARS)) (*DIF WIDTH MARG)))
		    (RETURN (SETRPR (SETLIST PLATE MARG REST)))))
	     (SETQ MARG (*DIF MARG (ADD1 (FLATSIZE (CADR EXPR)))))
	     (SETQ REST	(COMPOSLIST (CDDR EXPR)
				    (*DIF WIDTH MARG)
				    (ADD1 RPARS)
				    (PLUS SLACK (SUB1 MARG))))
	     (COND ((NOT (*GREAT (FULLWTH REST (ADD1 RPARS)) (*DIF WIDTH MARG)))
		    (RETURN (SETRPR (SETLIST PLATE MARG REST)))))
	     (RETURN (SETRPR (SETLIST PLATE
				      1
				      (COMPOSLIST (CDDR EXPR)
						  (SUB1 WIDTH)
						  (ADD1 RPARS)
						  SLACK))))))

(DFUNC (COMPOSATOMS ATOMS WIDTH RPARS SLACK)
       (PROG (PLATE WTH)
	     (SETQ PLATE (NEWPLATE))
	     (COND ((NOT (NULL ATOMS)) (SETEXPR PLATE (CAR ATOMS))
				       (SETQ ATOMS (CDR ATOMS))))
	LOOP (COND ((NULL ATOMS) (RETURN PLATE)))
	     (SETQ WTH (PLUS (COLUMN PLATE) 1 (FLATSIZE (CAR ATOMS))))
	     (COND ((NULL (CDR ATOMS)) (SETQ WTH (ADD1 WTH))))
	     (COND ((GREATERP WTH WIDTH) (SETTAB PLATE 0)) (T (SETSPC PLATE)))
	     (SETEXPR PLATE (CAR ATOMS))
	     (SETQ ATOMS (CDR ATOMS))
	     (GO LOOP)))

(DFUNC (COMPOSDEFS EXPR WIDTH RPARS SLACK)
 (PROG (PLATE MARG REST)
       (SETQ PLATE (NEWPLATE))
       (SETLPR PLATE)
       (SETEXPR PLATE (CAR EXPR))
       (SETSPC PLATE)
       (SETEXPR PLATE (CADR EXPR))
       (SETQ MARG (PLUS (FLATSIZE (CAR EXPR)) 2))
       (SETQ REST (COMPOSLIST (CDDR EXPR) (SUB1 WIDTH) (ADD1 RPARS) SLACK))
       (COND ((GREATERP (FULLWTH REST (ADD1 RPARS)) (*DIF WIDTH MARG))
	      (SETQ MARG 1)))
       (RETURN (SETRPR (SETLIST PLATE MARG REST)))))


(DFUNC (COMPOSDEDFDM EXPR WIDTH RPARS SLACK)
 (PROG (PLATE MARG MARG1 REST)
       (SETQ PLATE (NEWPLATE))
       (SETLPR PLATE)
       (SETEXPR PLATE (CAR EXPR))
       (SETSPC PLATE)
       (SETEXPR PLATE (CADR EXPR))
       (SETSPC PLATE)
       (SETEXPR PLATE (CADDR EXPR))
       (SETQ MARG1 (PLUS (FLATSIZE (CAR EXPR)) 2))
       (SETQ MARG (PLUS MARG1 (FLATSIZE (CADR EXPR)) 1))
       (SETQ REST (COMPOSLIST (CDDDR EXPR) (SUB1 WIDTH) (ADD1 RPARS) SLACK))
       (COND ((*GREAT (FULLWTH REST (ADD1 RPARS)) (*DIF WIDTH MARG))
	      (SETQ MARG MARG1)))
       (COND ((*GREAT (FULLWTH REST (ADD1 RPARS)) (*DIF WIDTH MARG))
	      (SETQ MARG 1)))
       (RETURN (SETRPR (SETLIST PLATE MARG REST)))))

(DFUNC (COMPOSEXPR EXPR WIDTH RPARS SLACK)
 (PROG (PLATE FIRST MARG REST TEM)
       (COND ((ATOM EXPR) (RETURN (SETEXPR (NEWPLATE) EXPR))))
       (COND ((AND (ATOM (CAR EXPR))
		   (NOT (NUMBERP (CAR EXPR)))
		   (SETQ TEM (GETGET (CAR EXPR) (Q INTERNFORM))))
	      (RETURN ((PROPVAL TEM) EXPR WIDTH RPARS SLACK))))
       (SETQ PLATE (SETEXPR (NEWPLATE) EXPR))
       (COND ((NOT (GREATERP (PLUS (COLUMN PLATE) RPARS) WIDTH))
	      (RETURN PLATE)))
       (SETQ PLATE (SETLPR (NEWPLATE)))
       (COND ((ATOM (CDR EXPR))
	      (RETURN (SETRPR (SETLIST PLATE
				       1
				       (COMPOSLIST EXPR
						   (SUB1 WIDTH)
						   (ADD1 RPARS)
						   SLACK))))))
       (SETQ FIRST (COMPOSEXPR (CAR EXPR) (SUB1 WIDTH) 0 SLACK))
       (SETQ MARG (PLUS (COLUMN FIRST) 2))
       (COND ((ATOM (CAR EXPR)) (GO ATOM)))
       (SETQ REST (COMPOSLIST (CDR EXPR) (SUB1 WIDTH) (ADD1 RPARS) SLACK))
       (COND ((OR (GREATERP (HEIGHT FIRST) 1)
		  (LESSP (*DIF WIDTH MARG) (FULLWTH REST (ADD1 RPARS))))
	      (RETURN (SETRPR (SETLIST PLATE 1 (SETPLATE FIRST REST))))))
       (RETURN (SETRPR (SETLIST (SETEXPR PLATE (CAR EXPR)) MARG REST)))
  ATOM (SETQ REST (COMPOSLIST (CDR EXPR)
			      (*DIF WIDTH MARG)
			      (ADD1 RPARS)
			      (PLUS SLACK (SUB1 MARG))))
       (COND ((LESSP (PLUS SLACK (*DIF WIDTH MARG)) (FULLWTH REST (ADD1 RPARS)))
	      (RETURN (SETRPR (SETLIST (SETEXPR PLATE (CAR EXPR))
				       1
				       (COMPOSLIST (CDR EXPR)
						   (SUB1 WIDTH)
						   (ADD1 RPARS)
						   SLACK))))))
       (RETURN (SETRPR (SETLIST (SETEXPR PLATE (CAR EXPR)) MARG REST)))))


(DFUNC (COMPOSLIST LIST WIDTH RPARS SLACK)
       (PROG (PLATE)
	     (SETQ PLATE (NEWPLATE))
	LOOP (SETPLATE PLATE
		       (COMPOSEXPR (CAR LIST)
				   WIDTH
				   (COND ((NULL (CDR LIST)) RPARS)
					 ((ATOM (CDR LIST))
					  (PLUS RPARS (FLATSIZE (CDR LIST)) 3))
					 (T 0))
				   SLACK))
	     (SETQ LIST (CDR LIST))
	     (COND ((NULL LIST) (RETURN PLATE)))
	     (COND ((ATOM LIST) (RETURN (SETATOM PLATE LIST))))
	     (GO LOOP)))

(DFUNC (COMPOSMAPDEF EXPR WIDTH RPARS SLACK)
       (PROG (ATOMS PLATE MARG)
	     (SETQ PLATE (NEWPLATE))
	     (SETLPR PLATE)
	     (SETEXPR PLATE (CAR EXPR))
	     (SETSPC PLATE)
	     (SETEXPR PLATE (CADR EXPR))
	     (SETSPC PLATE)
	     (SETQ MARG (COLUMN PLATE))
	     (SETQ ATOMS (COMPOSATOMS (CDDR EXPR)
				      (*DIF WIDTH MARG)
				      (ADD1 RPARS)
				      SLACK))
	     (RETURN (SETRPR (SETLIST PLATE MARG ATOMS)))))

(DFUNC (COMPOSPROG EXPR WIDTH RPARS SLACK)
 (PROG (PLATE INDENT PVARS STATS)
       (SETQ PLATE (NEWPLATE))
       (SETLPR PLATE)
       (SETEXPR PLATE (CAR EXPR))
       (SETSPC PLATE)
       (SETQ INDENT (PLUS (FLATSIZE (CAR EXPR)) 2))
       (SETQ PVARS (COMPOSPVARS	(CADR EXPR)
				(*DIF WIDTH INDENT)
				(COND ((NULL (CDDR EXPR)) (ADD1 RPARS)) (T 0))
				SLACK))
       (SETLIST PLATE INDENT PVARS)
       (SETQ STATS (CDDR EXPR))
  LOOP (COND ((NULL STATS) (RETURN (SETRPR PLATE))))
       (COND ((ATOM (CAR STATS)) (SETEXPR (SETTAB PLATE 1) (CAR STATS)))
	     (T	(SETLIST PLATE
			 INDENT
			 (COMPOSEXPR (CAR STATS)
				     (*DIF WIDTH INDENT)
				     (COND ((NULL (CDR STATS)) (ADD1 RPARS))
					   (T 0))
				     SLACK))))
       (SETQ STATS (CDR STATS))
       (GO LOOP)))


(DFUNC (COMPOSPVARS VARS WIDTH RPARS SLACK)
       (PROG (ATOMS PLATE)
	     (SETQ PLATE (NEWPLATE))
	     (COND ((OR	(ATOM VARS)
			(NOT (GREATERP (FLATSIZE VARS) (*DIF WIDTH RPARS))))
		    (RETURN (SETEXPR PLATE VARS))))
	     (SETQ ATOMS (COMPOSATOMS VARS (SUB1 WIDTH) (ADD1 RPARS) SLACK))
	     (RETURN (SETRPR (SETLIST (SETLPR PLATE) 1 ATOMS)))))

(DFUNC (COMPOSSPECIAL EXPR WIDTH RPARS SLACK)
       (PROG (ATOMS PLATE INDENT)
	     (SETQ PLATE (NEWPLATE))
	     (SETQ INDENT (PLUS (FLATSIZE (CAR EXPR)) 2))
	     (SETLPR PLATE)
	     (SETEXPR PLATE (CAR EXPR))
	     (SETSPC PLATE)
	     (SETQ ATOMS (COMPOSATOMS (CDR EXPR)
				      (*DIF WIDTH INDENT)
				      (ADD1 RPARS)
				      SLACK))
	     (RETURN (SETRPR (SETLIST PLATE INDENT ATOMS)))))

(DFUNC (CURCOL) (*DIF (ADD1 (LINELENGTH NIL)) (CHRCT)))

(DEFPROP DATAERR
	 (LAMBDA (L) (PROG NIL (INC NIL T) (OUTC NIL T) (PRINT L)))
	 FEXPR)

(DFUNC (DOEXCEPT EXPR WIDTH RPARS SLACK)
       ((GET (CAR EXPR) (Q EXCEPTCOMPOS)) EXPR WIDTH RPARS SLACK))

(DFUNC (DOSPEC EXPR WIDTH RPARS SLACK)
       (PROG (PLATE)
	     (SETQ PLATE (SETEXPR (NEWPLATE) EXPR))
	     (COND ((NOT (GREATERP (PLUS (COLUMN PLATE) RPARS) WIDTH))
		    (RETURN PLATE)))
	     (RETURN ((GET (CAR EXPR) (Q SPECCOMPOS)) EXPR WIDTH RPARS SLACK))))

(DFUNC (DOFILE DOREADS INFILE OUTFILE)
       (PROG (LINCNT)
	     (SETQ LINCNT 0)
	     (EVAL (MCONS (Q INPUT) (Q INCHAN) INFILE))
	     (EVAL (MCONS (Q OUTPUT) (Q OUTCHAN) OUTFILE))
	     (INC (Q INCHAN) NIL)
	     (OUTC (Q OUTCHAN) NIL)
	     (DOREADS)
	     (OUTC NIL T)
	     (INC NIL T)))


(DEFPROP FORMAT
 (LAMBDA (L)
  (PROG (DEV)
	(SETQ DEV (Q DSK:))
   LOOP	(COND ((NULL L) (RETURN NIL)))
	(COND ((%DEVP (CAR L)) (SETQ DEV (CAR L)) (SETQ L (CDR L))))
	(FORMFILE (LIST DEV (CAR L))
		  (LIST	(Q DSK:)
			(CONS (COND ((ATOM (CAR L)) (CAR L)) (T (CAAR L)))
			      (Q FMT))))
	(SETQ L (CDR L))
	(GO LOOP)))
 FEXPR)

(DFUNC (FORMFILE INFILE OUTFILE)
       (PROG (LINCNT)
	     (INC (EVAL (MCONS (Q INPUT) (GENSYM) INFILE)))
	     (OUTC (EVAL (MCONS (Q OUTPUT) (GENSYM) OUTFILE)))
	     (LINELENGTH PAGEWIDTH)
	     (SETQ LINCNT 1)
	     (FORMREADS)
	     (INC NIL T)
	     (OUTC NIL T)
	     (RETURN NIL)))

(DEFPROP FORMFUNS
	 (LAMBDA (NAMES)
		 (PROG (DONE PROP NAME FLAG FLAGS LINCNT)
		       (SETQ LINCNT 1)
		       (LINEF 1)
		  LOOP (COND ((NULL NAMES) (RETURN (REVERSE DONE))))
		       (SETQ FLAGS (QUOTE (EXPR FEXPR VALUE MACRO)))
		       (SETQ NAME (CAR NAMES))
		       (SETQ NAMES (CDR NAMES))
		  ILOOP(COND ((NULL FLAGS) (GO LOOP)))
		       (SETQ FLAG (CAR FLAGS))
		       (SETQ FLAGS (CDR FLAGS))
		       (SETQ PROP (GETL NAME (LIST FLAG)))
		       (COND ((NULL PROP) (GO ILOOP)))
		       (SETQ DONE (CONS (CONS NAME FLAG) DONE))
		       (SETQ PROP (CADR PROP))
		       (COND ((NOT (ATLEFT)) (LINEF 1)))
		       (FORMANEXPR (LIST (QUOTE DEFPROP) NAME PROP FLAG))
		       (LINEF 1)
		       (GO ILOOP)))
	 FEXPR)

(DFUNC (FORMF) (PROG NIL (PRINC *FF) (SETQ LINCNT 1)))


(DFUNC (FORMANEXPR ANEXPR)
       (PROG (PLATE)
	     (COND ((OR (ATOM ANEXPR) (NOT (EQ (CAR ANEXPR) (Q LAP))))
		    (SETQ PLATE (COMPOSEXPR ANEXPR (LINELENGTH NIL) 0 0))
		    (COND ((GREATERP (ADD1 (HEIGHT PLATE))
				     (*DIF PAGEHEIGHT (SUB1 LINCNT)))
			   (COND ((NOT (EQ LINCNT 1)) (FORMF)))))
		    (PRINTIT (TEXT PLATE) 0))
		   (T (PRINTLAP (READLAP ANEXPR))))
	     (COND ((NOT (ATLEFT)) (LINEF 2)))
	     (RETURN NIL)))

(DFUNC (FORMREADS) (READLOOP (FUNCTION FORMANEXPR)))

(DFUNC (FULLWTH PLATE RPARS) (MAX (WIDTH PLATE) (PLUS (COLUMN PLATE) RPARS)))

(DFUNC (LINEF NUM)
       (PROG NIL
	     (COND ((LESSP NUM 0) (RETURN NIL)))
	     (SETQ LINCNT (PLUS LINCNT NUM))
	LOOP (COND ((ZEROP NUM) (RETURN NIL)))
	     (TERPRI)
	     (SETQ NUM (SUB1 NUM))
	     (GO LOOP)))

(DFUNC (MAX N M) (COND ((GREATERP N M) N) (T M)))

(DFUNC (PRINTIT LIST TAB)
       (PROG (COM)
	LOOP (COND ((NULL LIST) (RETURN NIL)))
	     (SETQ COM (CAR LIST))
	     (COND ((EQ (CAR COM) (Q TAB)) (TABTO (ADD1 (PLUS TAB (CADR COM)))))
		   ((EQ (CAR COM) (Q SPACE)) (PRINC *SP))
		   ((EQ (CAR COM) (Q LPAR)) (PRINC *LP))
		   ((EQ (CAR COM) (Q RPAR)) (PRINC *RP))
		   ((EQ (CAR COM) (Q DOT)) (PRINC *PT))
		   ((EQ (CAR COM) (Q CHAR)) (PRINC (CADR COM)))
		   ((EQ (CAR COM) (Q EXPR)) (PRIN1 (CADR COM)))
		   ((EQ (CAR COM) (Q LIST))
		    (TABTO (ADD1 (PLUS TAB (CADR COM))))
		    (PRINTIT (CDDR COM) (PLUS TAB (CADR COM)))))
	     (SETQ LIST (CDR LIST))
	     (GO LOOP)))

(DFUNC (PRINTLAP LISTING)
       (PROG (STAT)
	LOOP (COND ((NULL LISTING) (RETURN NIL)))
	     (SETQ STAT (CAR LISTING))
	     (SETQ LISTING (CDR LISTING))
	     (PRINTSTAT STAT)
	     (GO LOOP)))

(DFUNC (PRINTN CHAR NUM)
       (PROG (NO)
	     (SETQ NO 1)
	LOOP (COND ((LESSP NUM NO) (RETURN NUM)))
	     (PRINC CHAR)
	     (SETQ NO (ADD1 NO))
	     (GO LOOP)))


(DFUNC (PRINTSTAT STAT)
       (PROG2 (COND ((NULL STAT) (TABTO 1) (TABTO 10))
		    ((ATOM STAT) (TABTO 2))
		    ((EQ (CAR STAT) (Q LAP)) (TABTO 1))
		    (T (TABTO 10)))
	      (PRIN1 STAT)))

(DFUNC (READLAP CALL)
       (PROG (STAT CODE)
	     (SETQ CODE (LIST CALL))
	READ (SETQ STAT (ERRSET (READ)))
	     (COND ((NULL STAT) (DATAERR EOF-READLAP)))
	     (COND ((EQ STAT (Q $EOF$)) (DATAERR EOF-READLAP)))
	     (SETQ STAT (CAR STAT))
	     (SETQ CODE (CONS STAT CODE))
	     (COND ((NULL STAT) (RETURN (REVERSE CODE))))
	     (GO READ)))

(DFUNC (READLOOP ACTFUNC)
       (PROG (EXPR)
	LOOP (SETQ EXPR (ERRSET (READ)))
	     (COND ((EQ EXPR (Q $EOF$)) (RETURN NIL)))
	     (ACTFUNC (CAR EXPR))
	     (GO LOOP)))

(DFUNC (SETATOM PLATE ATOM) (SETEXPR (SETSPC (SETDOT (SETSPC PLATE))) ATOM))

(DFUNC (SETCHAR PLATE CHAR)
       (ALTERWDTH (ALTERCOL (ALTERTEXT PLATE
				       (NCONC (TEXT PLATE)
					      (LIST (LIST (Q CHAR) CHAR))))
			    (ADD1 (COLUMN PLATE)))
		  (MAX (COLUMN PLATE) (WIDTH PLATE))))

(DFUNC (SETDOT PLATE) (SETCHAR PLATE *PT))

(DFUNC (SETEXPR PLATE EXPR)
       (ALTERWDTH (ALTERCOL (ALTERTEXT PLATE
				       (NCONC (TEXT PLATE)
					      (LIST (LIST (Q EXPR) EXPR))))
			    (PLUS (COLUMN PLATE) (FLATSIZE EXPR)))
		  (MAX (COLUMN PLATE) (WIDTH PLATE))))

(DFUNC (SETLIST PLATE NUM LIST)
 (ALTERCOL (ALTERWDTH (ALTERHT (ALTERTEXT PLATE
					  (NCONC (TEXT PLATE)
						 (LIST (MCONS (Q LIST)
							      NUM
							      (TEXT LIST)))))
			       (COND ((LESSP NUM (COLUMN PLATE))
				      (PLUS (HEIGHT PLATE) (HEIGHT LIST)))
				     (T	(SUB1 (PLUS (HEIGHT PLATE)
						    (HEIGHT LIST))))))
		      (MAX (WIDTH PLATE) (PLUS NUM (WIDTH LIST))))
	   (PLUS NUM (COLUMN LIST))))

(DFUNC (SETLPR PLATE) (SETCHAR PLATE *LP))


(DFUNC (SETPLATE PLATE1 PLATE2)
       (ALTERCOL (ALTERHT (ALTERWDTH (ALTERTEXT	PLATE1
						(NCONC (TEXT (SETTAB PLATE1 0))
						       (TEXT PLATE2)))
				     (MAX (WIDTH PLATE1) (WIDTH PLATE2)))
			  (SUB1 (PLUS (HEIGHT PLATE1) (HEIGHT PLATE2))))
		 (COLUMN PLATE2)))

(DFUNC (SETRPR PLATE) (SETCHAR PLATE *RP))

(DFUNC (SETSPC PLATE) (SETCHAR PLATE *SP))

(DFUNC (SETTAB PLATE COL)
 (ALTERCOL (ALTERWDTH (ALTERHT (ALTERTEXT PLATE
					  (NCONC (TEXT PLATE)
						 (LIST (LIST (Q TAB) COL))))
			       (COND ((LESSP COL (COLUMN PLATE))
				      (ADD1 (HEIGHT PLATE)))
				     (T (HEIGHT PLATE))))
		      (MAX (WIDTH PLATE) COL))
	   COL))

(DFUNC (TABTO COL)
       (PROG NIL
	     (COND ((GREATERP (CURCOL) COL) (LINEF 1)))
	     (PRINTN *TB (*DIF (LSH (SUB1 COL) -3) (LSH (SUB1 (CURCOL)) -3)))
	     (PRINTN *SP (*DIF COL (CURCOL)))))

(SETQ PAGEHEIGHT 64)

(SETQ PAGEWIDTH 105)

(MAPCAR	(FUNCTION (LAMBDA (PAIR)
			  (PROG2 (SET (CAR PAIR) (INTERN (ASCII (CADR PAIR))))
				 (CAR PAIR))))
	(QUOTE ((*SP 40) (*TB 11)
			 (*CR 15)
			 (*LF 12)
			 (*VT 13)
			 (*FF 14)
			 (*CO 54)
			 (*PT 56)
			 (*LP 50)
			 (*RP 51)
			 (*SL 57)
			 (*AM 33)
			 (*AT 100)
			 (*RO 177)
			 (*COLON 72)
			 (*LB 133)
			 (*RB 135))))

(MAPDEF INTERNFORM (EXCEPTCOMPOS DOEXCEPT) (SPECCOMPOS DOSPEC))

(MAPDEF SPECCOMPOS (COMMENT COMPOSSPECIAL) (DE COMPOSDEDFDM)
		   (DEFPROP COMPOSDEFS) (DF COMPOSDEDFDM) (DFUNC COMPOSDEFS)
		   (DM COMPOSDEDFDM) (GETSYM COMPOSMAPDEF) (LABEL COMPOSASSIGN)
		   (LAMBDA COMPOSDEFS) (MAPDEF COMPOSMAPDEF) (PROG COMPOSPROG)
		   (SETQ COMPOSASSIGN) (SPECIAL COMPOSSPECIAL))